home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
A.C.E. 2
/
ACE CD 2.iso
/
FILES
/
UTILS
/
AMOS3.DMS
/
AMOS3.adf
/
Extensions
/
Request.s
< prev
Wrap
Text File
|
1978-10-10
|
9KB
|
384 lines
Include "Equ.s"
Include "Pointe.s"
******************************************************************
* ** * * **** **** *** ** **** *** ***
* * * ** ** * * * * * * * * * *
* **** * ** * * * **** **** **** **** * *
* * * * * * * * * * * * * * *
* * * * * **** **** **** * * **** *** ***
******************************************************************
* AMOS REQUESTER HANDLER
*
* By Francois Lionet
*
* AMOS Basic (c) 1990 Mandarin / Jawx
******************************************************************
* This source code is public domain. You can freely copy,
* modify, distribute it. Experiment with it, and have fun!
******************************************************************
*-----------------------------------------------------------------
* Note to all machine language programmers!
* I have been doing this requester keeping it SIMPLE, and
* SMALL. It is just 1186 bytes long. Of course, you can
* make a new one. I would love to see your new wicked
* requesters. Think about public domain: having your name
* displayed each time an error occurs (specially bad ones)!!!
*
* It is late, I am very tired, the requester is finished
* now, I'll go to bed! AMOS to be on sale in 5 days!
*
* Have fun! Francois Lionet
*
* PS: when you make an extension, make the code relative (pc),
* thinking to the compiler.
* PPS: do not forget to call UnMix1 and UnMix2 routines before
* doing anything: if the requester does not come from AMOS,
* AMOS will continue to use screens, and interfer with the
* requester...
* PPPS: for more info on AMOS extension interface, refer to
* the music extension...
*-----------------------------------------------------------------
* 2 new instructions, not documented (sorry!)
* - REQUEST OFF --> no requester, as if you were
* always clicking CANCEL (really nice this one!)
* - REQUEST ON --> this magnificent requester
*-----------------------------------------------------------------
******************************************************************
* AMOS INTERFACE
******* COLD START
lea ReqData(pc),a4
move.l a0,Branch-ReqData(a4) * Address of BRANCH TABLE
move.l a5,Datas-ReqData(a4)
lea DefEPa+8(a5),a0 * Default palette + req palette
lea ReqPal+8(pc),a1
moveq #28-1,d0
CPal move.w (a0)+,(a1)+
dbra d0,CPal
lea ReqFlag(pc),a0 * Default is ON!
move.w #-1,(a0)
moveq #0,d2 * No check bank
lea Tk(pc),a0 * Address of TOKEN TABLE
lea ReqWel(pc),a1 * Address of WELCOME MESSAGE
lea ReqDef(pc),a2 * Address of SCREEN RESET
lea ReqEnd(pc),a3 * Address of QUIT
moveq #2,d1 * Returns NUMBER OF EXTENSION
moveq #0,d0 * NO ERRORS
rts
******* SCREEN RESET
ReqDef: rts
******* QUIT
ReqEnd: rts
******* REQUEST ON
ReqOn moveq #-1,d0
bra.s ROnOf
******* REQUEST OFF
ReqOf moveq #0,d0
ROnOf lea ReqFlag(pc),a0
move.w d0,(a0)
rts
***********************************************************
* AMOS REQUESTER
Request move.w ReqFlag(pc),d0
beq AlwNo
movem.l a0-a6/d1-d7,-(sp)
******* Screen setup (boring!!!)
SyCall AMALFrz
lea ReqData(pc),a6
move.l Datas-ReqData(a6),a5
bsr UnMix1
move.w #288,d0
move.w d2,d1
lsr.w #2,d1
sub.w d1,d0
move.w d0,ReqWX-ReqData(a6)
move.l d2,d0
lsr.w #3,d0
move.w d0,ReqSX-ReqData(a6)
add.w #16,d3 * 2 lines in Y!!!
move.w d3,d0
lsr.w #1,d0
move.w d0,ReqSY-ReqData(a6)
move.l a1,ReqMain-ReqData(a6)
move.l a2,ReqPos-ReqData(a6)
move.l a3,ReqNeg-ReqData(a6)
* Open screen
moveq #2,d4
move.l #$8000,d5
moveq #4,d6
moveq #0,d7
lea ReqPal-ReqData(a6),a1
EcCalD Cree,EcReq
bne NoReq
move.l a0,ScAdr-ReqData(a6)
SyCalD ResZone,2
* Initialise background text
WiCalA Print,ReqBack-ReqData(a6)
WiCalA Centre,ReqTit-ReqData(a6)
* Print main text
moveq #0,d1
moveq #4,d2
WiCall Locate
move.l ReqMain-ReqData(a6),a4
MnText move.l 12(a4),a1
WiCall Centre
WiCalD ChrOut,10
move.l 16(a4),d0
move.l d0,a4
bne.s MnText
* Positive text (left)
move.l ReqPos-ReqData(a6),d0
beq.s NoPos
move.l d0,a0
move.l 12(a0),d0
beq.s NoPos
move.l d0,ReqPos-ReqData(a6)
moveq #1,d0
moveq #"0",d1
bsr PrtZone
* Negative text (right)
NoPos move.l ReqNeg-ReqData(a6),d0
beq.s NoNeg
move.l d0,a0
move.l 12(a0),d0
beq.s NoPos
move.l d0,ReqNeg-ReqData(a6)
move.l d0,a0
CptNeg tst.b (a0)+
bne.s CptNeg
sub.l d0,a0
move.w ReqSx-ReqData(a6),d0
sub.w a0,d0
add.b #48,d0
move.b d0,XTNeg-ReqData(a6)
moveq #2,d0
moveq #"0",d1
bsr PrtZone
* Screen appearance
NoNeg move.l ScAdr-ReqData(a6),a2
move.w ReqWX-ReqData(a6),EcAWX(a2)
bset #1,EcAW(a2)
moveq #8,d7
moveq #1,d6
moveq #ReqWY,d5
add.w ReqSY-ReqData(a6),d5
bsr AppCentre
bsr UnMix2
******* Test loop (fun!)
ReqLoop SyCall WaitVbl
* Keyboard
SyCall Inkey
cmp.w #13,d1 * ASCII-> Return
beq.s ReqYes
cmp.w #27,d1 * ASCII-> ESC
beq.s ReqNo
* Don't you think it is better than this wierd Amiga V and B?
* Sometime I ask myself what they were thinking when they chose such
* key combinations!
swap d1
move.w d1,d0 * Isolate AMIGA keys
and.w #%1100000000000000,d0
beq.s RqL0
cmp.b #$34,d1 * V
beq.s ReqYes
cmp.b #$35,d1 * B
beq.s ReqNo
* Mouse pointer
RqL0 SyCall GetZone
cmp.w #EcReq,d1
beq.s RqL1
moveq #0,d1
RqL1: swap d1
cmp.w d7,d1
beq.s RqL2
move.w d7,d0
move.w d1,d7
moveq #"0",d1
bsr UnMix1
bsr PrtZone
bsr UnMix2
RqL2: move.w d7,d0
moveq #"1",d1
bsr UnMix1
bsr PrtZone
bsr UnMix2
tst.w d7
beq.s ReqLoop
SyCall MouseKey
tst.w d1
beq ReqLoop
cmp.w #2,d7
beq.s ReqNo
ReqYes moveq #-1,d0
bra.s ReqGo
ReqNo moveq #0,d0
******* End of screen (well done!!!)
ReqGo move.l d0,-(sp)
bsr UnMix1
move.l ScAdr-ReqData(a6),a2
moveq #-8,d7
move.w EcTY(a2),d6
lsr.w #1,d6
moveq #ReqWY,d5
add.w ReqSY-ReqData(a6),d5
bsr AppCentre
EcCalD Del,EcReq
bsr UnMix2
******* Back to system!
ReqX SyCall AMALUFrz
move.l (sp)+,d0 * Returns answer
movem.l (sp)+,a0-a6/d1-d7
rts
******* Can't open screen!!!
NoReq clr.l -(sp)
bra.s ReqX
******* Always no!!!
AlwNo moveq #0,d0
rts
******* Print a zone D0-> zone, D1-> inverse or not
PrtZone subq.w #1,d0
bmi.s PrtX
bne.s PrtNeg
* Print pos text
PrtPos lea TPos1-ReqData(a6),a1
move.b d1,5(a1)
WiCall Print
move.l ReqPos-ReqData(a6),a1
WiCall Print
WiCalA Print,TPos2-ReqData(a6)
bra.s PrtX
* Print neg text
PrtNeg lea TNeg1-ReqData(a6),a1
move.b d1,5(a1)
WiCall Print
move.l ReqNeg-ReqData(a6),a1
WiCall Print
WiCalA Print,TNeg2-ReqData(a6)
PrtX rts
******* Screen appearance
AppCentre:
move.w d6,d4
move.w d6,EcAWTy(a2)
add.w d6,EcAWTy(a2)
bset #2,EcAWT(a2)
move.w EcTy(a2),d0
lsr.w #1,d0
sub.w d6,d0
move.w d0,EcAVY(a2)
bset #2,EcAV(a2)
move.w d5,EcAWy(a2)
sub.w d6,EcAWy(a2)
bset #2,EcAW(a2)
movem.l a2/d4-d7,-(sp)
SyCall WaitVBL
EcCall CopForce
movem.l (sp)+,a2/d4-d7
add.w d7,d6
bpl.s FsApp2
clr.w d6
FsApp2: move.w EcTy(a2),d0
lsr.w #1,d0
cmp.w d0,d6
bcs.s FsApp3
move.w d0,d6
FsApp3: cmp.w d4,d6
bne.s AppCentre
rts
******* Prevent mixes between AMOS and the requester!
UnMix1 movem.l d0-d7/a0-a6,-(sp)
move.l $4,a6
jsr Forbid(a6)
EcCall Current
move.w EcNumber(a0),d1
lea ReqOld(pc),a0
move.w d1,(a0)
EcCalD Active,EcReq
EcCalD First,EcReq
movem.l (sp)+,d0-d7/a0-a6
rts
UnMix2 movem.l d0-d7/a0-a6,-(sp)
move.w ReqOld(pc),d1
EcCall Active
move.l $4,a6
jsr Permit(a6)
movem.l (sp)+,d0-d7/a0-a6
rts
***********************************************************
* TOKEN TABLE + Addresses
* On loading, AMOS changes the AUTOREQUEST vector using the
* following address, so it's got to be there!
dc.l Request
Tk: dc.w 1,0
dc.b $80,-1
dc.w ReqOn-Tk,1
dc.b "Request o","n"+$80,"I",-1
dc.w ReqOf-Tk,1
dc.b "Request of","f"+$80,"I",-1
dc.w 0
***********************************************************
* DATA ZONE
ReqData dc.l 0
Branch dc.l 0
ScAdr dc.l 0
Datas dc.l 0
ReqMain dc.l 0
ReqPos dc.l 0
ReqNeg dc.l 0
ReqWX dc.w 0
ReqWY equ 103
ReqSx dc.w 0
ReqSY dc.w 0
ReqFlag dc.w 0
ReqOld dc.w 0
ReqPal dc.w $000,$46C,$FFF,$C41
ds.w 28
* Background drawing
ReqBack dc.b 27,"C0",27,"V0"
dc.b 24,28,31,27,"E0",24,29,30,27,"E2"
dc.b 27,"B3",24,31,7
dc.b 24,28,31,27,"E0",29,29,31,27,"E2"
dc.b 24,31
dc.b 0
* Title
ReqTit dc.b "System request",27,"B1",0
* Positive text
TPos1 dc.b 27,"B3",27,"I0",24,30,30,28,27,"E0",27,"Z0",0
TPos2 dc.b 27,"E2",27,"Z1",0
* Negative text
TNeg1 dc.b 27,"B3",27,"I0",24,30,30,27,"X"
XTNeg dc.b "0",27,"E0",27,"Z0",0
TNeg2 dc.b 27,"E2",27,"Z2",0
*************** Welcome message
ReqWel: dc.b 27,"Y",48+10,"Requester V 1.1",0
***************
dc.l 0